set locale encoding after fdTohandle

fdToHandle does not set the usual system locale encoding,
so when the Handle is used for any String IO, it needs to be done
manually for correctness.

I don't know if this fixes any bugs. It might eg, fix a bug with
multicast receive of a file.

Sponsored-by: Leon Schuermann

diff --git a/Annex/Multicast.hs b/Annex/Multicast.hs
index a559c76c23d0d5e5d7c00261d586b6990ade1de4..4fe3e0af6c42d75dfc09cb187b7b80b808efdbc4 100644 (file)
--- a/Annex/Multicast.hs
+++ b/Annex/Multicast.hs
@@ -18,6 +18,7 @@ import System.Posix.IO
 #else
 import System.Process (createPipeFd)
 #endif
+import GHC.IO.Encoding (getLocaleEncoding)
 
 multicastReceiveEnv :: String
 multicastReceiveEnv = "GIT_ANNEX_MULTICAST_RECEIVE"
@@ -34,6 +35,7 @@ multicastCallbackEnv = do
        (rfd, wfd) <- createPipeFd
 #endif
        rh <- fdToHandle rfd
+       getLocaleEncoding >>= hSetEncoding rh
        environ <- addEntry multicastReceiveEnv (show wfd) <$> getEnvironment
        return (gitannex, environ, rh)
 
@@ -46,6 +48,7 @@ runMulticastReceive :: [String] -> String -> IO ()
 runMulticastReceive ("-I":_sessionid:fs) hs = case readish hs of
        Just fd -> do
                h <- fdToHandle fd
+               getLocaleEncoding >>= hSetEncoding h
                mapM_ (hPutStrLn h) fs
                hClose h
        Nothing -> return ()

diff --git a/Assistant.hs b/Assistant.hs
index 3ad89269601da10627ee5a6cdf4ed7520d7dda9a..911ebd33d35da21656d9664d1e56ad5b6fa8e477 100644 (file)
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -56,6 +56,8 @@ import Annex.Path
 #ifdef mingw32_HOST_OS
 import Utility.Env
 import System.Environment (getArgs)
+#else
+import GHC.IO.Encoding (getLocaleEncoding)
 #endif
 import qualified Utility.Debug as Debug
 
@@ -82,10 +84,15 @@ startDaemon assistant foreground startdelay cannotrun listenhost listenport star
        let logfd = handleToFd =<< openLog (fromOsPath logfile)
        if foreground
                then do
-                       origout <- liftIO $ catchMaybeIO $ 
-                               fdToHandle =<< dup stdOutput
-                       origerr <- liftIO $ catchMaybeIO $ 
-                               fdToHandle =<< dup stdError
+                       enc <- liftIO getLocaleEncoding
+                       origout <- liftIO $ catchMaybeIO $ do
+                               h <- fdToHandle =<< dup stdOutput
+                               hSetEncoding h enc
+                               return h
+                       origerr <- liftIO $ catchMaybeIO $ do
+                               h <- fdToHandle =<< dup stdError
+                               hSetEncoding h enc
+                               return h
                        let undaemonize = Utility.Daemon.foreground logfd (Just pidfile)
                        start undaemonize $ 
                                case startbrowser of

diff --git a/Utility/LockFile/PidLock.hs b/Utility/LockFile/PidLock.hs
index 67cf78d62ebee8bb33c210d715a1e853c0751de4..6cd556b34c756502dd35a37e91e760eaf54fbe0e 100644 (file)
--- a/Utility/LockFile/PidLock.hs
+++ b/Utility/LockFile/PidLock.hs
@@ -49,6 +49,7 @@ import System.Posix.Types
 import System.Posix.IO.ByteString
 import System.Posix.Files.ByteString
 import System.Posix.Process
+import GHC.IO.Encoding (getLocaleEncoding)
 import Control.Monad
 import Control.Monad.IO.Class (liftIO, MonadIO)
 import Data.Maybe
@@ -213,7 +214,9 @@ linkToLock (Just _) src dest = do
                                        (Just $ combineModes readModes)
                                        (defaultFileFlags { exclusive = True })
                                        (CloseOnExecFlag True)
-                               fdToHandle fd
+                               h <- fdToHandle fd
+                               getLocaleEncoding >>= hSetEncoding h
+                               return h
                        let cleanup = hClose
                        let go h = F.readFileString src >>= hPutStr h
                        bracket setup cleanup go

diff --git a/Utility/Process/Transcript.hs b/Utility/Process/Transcript.hs
index cb71e30b9162cd53c8cbf54af8b77034d494d815..0dd415337218d424e4cb60c5a897951c5e1069d2 100644 (file)
--- a/Utility/Process/Transcript.hs
+++ b/Utility/Process/Transcript.hs
@@ -23,6 +23,7 @@ import Control.Monad
 #ifndef mingw32_HOST_OS
 import Control.Exception
 import qualified System.Posix.IO
+import GHC.IO.Encoding (getLocaleEncoding)
 #else
 import Control.Applicative
 #endif
@@ -51,6 +52,9 @@ processTranscript'' cp input = do
                System.Posix.IO.setFdOption writef System.Posix.IO.CloseOnExec True
                readh <- System.Posix.IO.fdToHandle readf
                writeh <- System.Posix.IO.fdToHandle writef
+               enc <- getLocaleEncoding
+               hSetEncoding readh enc
+               hSetEncoding writeh enc
                return (readh, writeh)
        let cleanup (readh, writeh) = do
                hClose readh